home *** CD-ROM | disk | FTP | other *** search
/ Utilities Professional 1-1500 / Utilities Professional 1-1500 (1994)(WPD)[!].iso / 10011250 / var1219.dms / var1219.adf / ARexxGuide / ARx_Help.ttx < prev    next >
Text File  |  1992-09-02  |  13KB  |  460 lines

  1. /** $VER: ARX_GetRef.ttx 0.2 (21 Jul 1993)
  2.  ** by Robin Evans (based on getxfef.ttx by David N. Junod)
  3.  **
  4.  ** Display the ARexxGuide page for the word currently under the
  5.  ** cursor.
  6.  **
  7.  ** Add the following line to your TTX_Startup.dfn file, in the KEYBOARD:
  8.  ** section.
  9.  **
  10.  **   HELP        ExecARexxMacro REXX:GetXRef.ttx SYNC
  11.  **   SHIFT-HELP  ExecARexxMacro REXX:GetXRef.ttx ASYNC
  12.  **
  13.  ** Add the following lines to your S:user-startup file.
  14.  **
  15.  **   RX "AddLib('amigaguide.library',0,-30)"
  16.  **/
  17.  
  18. TRUE=1; FALSE=0
  19.  
  20. options results
  21. parse arg Mode LkUp
  22.  
  23. if ~show('L','amigaguide.library') then
  24.      call addlib('amigaguide.library',0,-30)
  25. if ~show('L','rexxarplib.library') then
  26.      call addlib('rexxarplib.library',0,-30)
  27.  
  28.     /* Did they pass a word? */
  29. if LkUp = "" then do
  30.         /* Get all the line info we'll need and lock out input until **
  31.         ** it's all collected.                                                     **
  32.         ** Check for special characters first                                  */
  33.     'SetInputLock on'
  34.     'GetLine 1'
  35.     HLine = Tab2Space(result)
  36.     'GetCursorPos'
  37.     CurPos = word(result, 2)
  38.     'GetChar'
  39.     MChar = pos(result, '+-/*|&^><=,;:~)("'||'2720090a'x)
  40.     'SetInputLock off'
  41.     select
  42.         when MChar = 0 then do
  43.                 /* Look for whole word if it isn't a special character */
  44.             'GetWord'
  45.             LkUp = result
  46.         end
  47.         when MChar <= 2 then
  48.             LkUp = 'ARITHMETIC'
  49.         when MChar <= 4 then do
  50.                 /* This picks up the three characters surrounding a '*' or '/' */
  51.             ComChar = substr(HLine, CurPos - 1, 3)
  52.             if pos('/*', ComChar) + pos('*/', ComChar) > 0 then
  53.                 LkUp = 'COMMENT'
  54.             else
  55.                 LkUp = 'ARITHMETIC'
  56.         end
  57.         when MChar <= 7 then
  58.             LkUp = 'LOGICAL'
  59.         when MChar <= 9 then
  60.             LkUp = 'COMPARISON'
  61.         when MChar = 10 then
  62.             if symbol(strip(left(HLine, CurPos-1))) == 'BAD' then
  63.                 LkUp = 'COMPARISON'
  64.             else
  65.                 LkUp = 'ASSIGNMENT'
  66.         when MChar = 11 then
  67.             LkUp = 'COMMA'
  68.         when MChar = 12 then
  69.             LkUp = 'SEMICOLON'
  70.         when MChar = 13 then
  71.             LkUp = 'LABEL'
  72.         when MChar = 14 then do        /* Tilde           */
  73.                 /* is the next character a comparison operator? */
  74.             if pos(substr(HLine, CurPos , 2), '~=~>~<') > 0 then
  75.                 LkUp = 'COMPARISON'
  76.             else
  77.                 LkUp = 'LOGICAL'
  78.         end
  79.         when MChar <=16 then
  80.             LkUp = 'PAREN'
  81.         when MChar <= 18 then        /* Quotation marks */
  82.             LkUp = 'STRING'
  83.         when MChar > 18 then
  84.             if HLine = '' | verify(HLine, ' ;') = 0 then do
  85.                 call ShowInfo(,, CurPos)
  86.                 exit
  87.             end
  88.             else if CurPos >= wordindex(HLine, 1) then do
  89.                 'GetWord'
  90.                 LkUp = result
  91.             end
  92.             else do
  93.                 call ShowInfo(HLine,, CurPos)
  94.                 exit
  95.             end
  96.         otherwise
  97.     end
  98. end
  99.     /* Show that we're doing something */
  100. 'SetStatusBar TEMPORARY Checking for 'LkUp'...'
  101.  
  102. /* See if the ARexxGuide cross-reference table is loaded */
  103.  
  104. if GetXRef("pragma()") = 10 then do
  105.  
  106.         /* Show that we're doing something */
  107.     'SetStatusBar TEMPORARY Loading cross-reference file...'
  108.         /* The ARexxGuide table wasn't loaded, so load it. */
  109.     call LoadXRef('ARx_Guide.xref')
  110. end
  111.  
  112.     /* Show functions as first preference */
  113. XMatch = TRUE
  114. if GetXRef(LkUp'()') ~= 10 then
  115.         /* Make sure it's used as a function */
  116.     if pos(LkUp'(', HLine) > 0 | pos(LkUp"'(", HLine) > 0 | pos(LkUp'"(', HLine) > 0 then
  117.         LkUp = LkUp'()'
  118.  
  119.     /* if it's not a match of instructions, then check for option words */
  120. if GetXRef(LkUp) = 10 | upper(LkUp) == 'ARG' | upper(LkUp) == 'PULL' then do
  121.     Kwd = upper(word(HLine, 1))
  122.     if word(GetXRef(Kwd),3) = 2 then select
  123.         when Kwd == 'ARG' then
  124.             XMatch = TRUE
  125.         when Kwd == 'PULL' then
  126.             XMatch = TRUE
  127.         when Kwd = 'DO' then do
  128.             SpecWord = find('UNTIL WHILE TO FOR BY FOREVER ', upper(LkUp))
  129.             if SpecWord > 0 then
  130.                 LkUp = word('DOOPT4 DOOPT4 DOOPT2 DOOPT3 DOOPT2 DOOPT5', SpecWord)
  131.             else XMatch = FALSE
  132.         end
  133.         when Kwd = 'PARSE' then do
  134.             SpecWord = find('ARG PULL EXTERNAL NUMERIC SOURCE VERSION VALUE VAR WITH', upper(LkUp))
  135.             if SpecWord > 0 then do
  136.                 LkUp = 'PARSESRC'SpecWord
  137.                 if LkUp == 'PARSESRC9' then
  138.                     LkUp = 'PARSESRC7'
  139.             end
  140.             else XMatch = FALSE
  141.         end
  142.         when Kwd = 'OPTIONS' then
  143.             if find('RESULTS PROMPT FAILAT CASHE ON OFF', upper(LkUp)) > 0 then
  144.                 LkUp = Kwd
  145.             else XMatch = FALSE
  146.         when Kwd = 'TRACE' then
  147.             if verify(upper(LkUp), 'IRACLENOBS') = 0 then
  148.                 LkUp = 'TRACEOPT'
  149.             else XMatch = FALSE
  150.         when Kwd = 'SIGNAL' then
  151.             if find('BREAK_C BREAK_D BREAK_E BREAK_F ERROR FAILURE HALT IOERROR NOVALUE SYNTAX ON OFF', upper(LkUp)) > 0 then
  152.                 LkUp = 'SIGNAL'
  153.             else XMatch = FALSE
  154.         otherwise
  155.             XMatch = FALSE
  156.     end
  157.     else XMatch = FALSE
  158. end
  159.  
  160. AGCmd = getenv('ARexxGuide/AGCmd')
  161. if abbrev(AGCmd, 'Multi') then
  162.     PrtOpt = ''
  163. else
  164.     PrtOpt = 'portname ARX_GUIDE'
  165.  
  166. if ~XMatch then do
  167.     foo= ShowInfo(HLine, LkUp, CurPos)
  168.  
  169. /*
  170.     'RequestBool "'center(upper(LkUp) 'not found.',37)'" "'center('Show ARexxGuide index?',37)'"'
  171.     if result = 'YES' then do
  172.         XMatch = TRUE; LkUp = 'ARx_Index/MAIN'
  173.        Cmd = 'run' AGCmd 'ARx_Index' PrtOpt 'requester'
  174.     end
  175. */
  176. end
  177. else do
  178.     NTNum = word(getxref(LkUp), 3)
  179.     NodeType.0 = 'Explanation'; NodeType.1 = 'Function'; NodeType.2 = 'Instruction'
  180.         /* Show that we're doing something */
  181.     'SetStatusBar ARexxGuide: 'upper(LkUp) '['NodeType.NTNum']'
  182.  
  183.     Cmd = ''
  184.  
  185.         /* See if our AG window is open */
  186.     if ~show('P','ARX_GUIDE') then do
  187.         if Cmd = '' then
  188.            Cmd = 'run' AGCmd 'document' LkUp PrtOpt 'requester'
  189.  
  190.         address command cmd
  191.     end
  192.     else do
  193.  
  194.             /* What command do we use to show the node */
  195.         Link = "Link"
  196.         if mode = "ASYNC" then
  197.            Link = "ALink"
  198.         else
  199.             call setclip('ARx_NdxWin')        /* clear the asynch clip */
  200.  
  201.             /* show the node */
  202.         address ARX_GUIDE 'windowtofront'
  203.         address ARX_GUIDE 'Link' LkUp
  204.  
  205.     end
  206. end
  207.  
  208. exit
  209.  
  210. ShowInfo: procedure expose AGCmd
  211.  
  212.     parse arg HLine, LkUp, CurPos
  213.         /* Show that we're doing something */
  214.     'SetStatusBar TEMPORARY "'LkUp'" not found. Checking clause...'
  215.  
  216.         /* this will break if a semicolon is used within a string */
  217.     SemPos = pos(';', HLine)
  218.     do while SemPos > 0 & SemPos < CurPos
  219.         parse var HLine ';' HLine
  220.         CurPos = CurPos - SemPos
  221.         SemPos = pos(';', HLine)
  222.     end
  223.         /* get rid of any trailing clauses */
  224.     parse var HLine HLine ';'
  225.  
  226.     if ~abbrev(AGCmd, 'Multi') then
  227.         ExecStr = 'ExecARexxString address ARXTTX quit;    if ~show(P, ARX_GUIDE) then do; address command; run "'getenv("arexxguide/AGCmd") 'ARexxGuide.guide portname ARX_GUIDE";waitforport ARX_GUIDE; end; address ARX_GUIDE; windowtofront;'
  228.     else
  229.         ExecStr = 'ExecARexxString address ARXTTX quit;    address command; run "'AGCmd'"ARexxGuide.guide"'
  230.  
  231.         /* figure out what type of clause the current line is */
  232.     select
  233.         when word(HLine, 2) = '=' then do
  234.             CType = 2
  235.         end
  236.         when getxref(word(HLine,1)) ~= 10 then do
  237.             Xref = getxref(word(HLine,1))
  238.             if word(Xref,3) = 2 then
  239.                 CType = 1
  240.         end
  241.         when pos('/*', HLine) < CurPos & pos('/*', HLine) ~= 0 then
  242.             if pos('*/', HLine) > CurPos | pos('*/', HLine) = 0 then
  243.                 CType = 4
  244.         when right(word(HLine,1), 1) = ':' then
  245.             CType = 3
  246.         when HLine = '' then
  247.             CType = 5
  248.         otherwise
  249.             CType = 0
  250.             EqPos = pos('=', HLine)
  251.             if EqPos > 0 then do
  252.                 if symbol(strip(left(HLine, EqPos-1))) ~= 'BAD' then do
  253.                     HLine=insert(' ', HLine, EqPos - 1)
  254.                     HLine = insert(' ', HLine, EqPos + 2)
  255.                     CType = 2
  256.                 end
  257.             end
  258.     end
  259.     if CType = 2 then
  260.         if ~IsVar(word(HLine, 1)) then
  261.             CType = 0
  262.     /* Prepare the window gadgets */
  263.     CName.0 = 'Command'
  264.     CName.1 = 'Instruction'
  265.     CName.2 = 'Assignment'
  266.     CName.3 = 'Label'
  267.     CName.4 = 'Comment'
  268.     CName.5 = 'Null'
  269.     Gad. = ''
  270.     Gad.1.6Txt = 'Current clause is'
  271.     Gad.1.6Btn = CName.CType
  272.     Gad.1.6Cmd = ExecStr 'link' CName.CType
  273.     Gadgets = 1
  274.     select
  275.         when CType = 1 then do
  276.             Kwd = upper(word(HLine,1))
  277.             Gad.2.6Txt = 'Current keyword is'
  278.             Gad.2.6Btn = Kwd
  279.             Gad.2.6Cmd = ExecStr 'link' Kwd
  280.             Gadgets = 2
  281.         end
  282.         when CType = 3 then do
  283.             Gad.2.6Txt = 'Name of subroutine:' word(HLine,1)'.'
  284.             Gadgets = 2
  285.         end
  286.         otherwise
  287.     end
  288.  
  289.             /* Figure out what the current word is doing */
  290.     if CType <= 2 & LkUp > '' then do
  291.         DType = datatype(LkUp)
  292.             /* Split the string so we can compare both sides */
  293.         parse var HLine LStr =CurPos RStr
  294.             /* Get only the portion of the string which contains LkUp */
  295.         WdRange = substr(HLine, max(1, CurPos - length(LkUp)), length(LkUp) *2)
  296.  
  297.             /* Use Bit functions to keep multiple matches */
  298.         WType = null()
  299.         if verify(HLine, '"''', M) > 0 then
  300.             if CountChar(LStr, "'")//2 then do
  301.                 WType = bitset(WType,2)
  302.                 if pos(LkUp"'(", WdRange) & IsVar(LkUp) then
  303.                         WType = bitset(WType, 0)
  304.             end
  305.             else if CountChar(LStr, '"')//2 then do
  306.                 WType = bitset(WType,3)
  307.                 if pos(LkUp'"(', WdRange) & IsVar(LkUp) then
  308.                         WType = bitset(WType, 0)
  309.             end
  310.  
  311.             /* Is current word enclosed in parens? */
  312.         if verify(HLine, "()", M) > 0 then do
  313.             if (CountChar(RStr, ')')-CountChar(RStr, '(')) =,
  314.               (CountChar(LStr, '(')-CountChar(LStr, ')')) then
  315.                     WType = bitset(WType, 1)
  316.             if pos(LkUp'(', WdRange) > 0 & IsVar(LkUp) then
  317.                     WType = bitset(WType, 0)
  318.         end
  319.             /* is it a number, variable, or constant? */
  320.         if datatype(LkUp, N) then
  321.             if datatype(LkUp, B) & bittst(WType, 2) then
  322.                 if pos(LkUp"'B", upper(WdRange)) > 0 |  pos(LkUp'"B', upper(WdRange)) > 0 then
  323.                     WType = bitset(WType, 6)
  324.                 else
  325.                     WType = bitset(WType, 4)
  326.             else if datatype(LkUp, X) & bittst(WType, 2) then
  327.                 if pos(LkUp"'X", upper(WdRange)) > 0 |  pos(LkUp'"X', upper(WdRange)) > 0 then
  328.                     WType = bitset(WType, 5)
  329.                 else
  330.                     WType = bitset(WType, 4)
  331.             else
  332.                 WType = bitset(WType, 4)
  333.         else
  334.             if bittst(WType, 2) then do
  335.                 if datatype(LkUp, X) then
  336.                     WType = bitset(WType, 5)
  337.             end
  338.             else if IsVar(LkUp) then
  339.                 if ~bittst(WType, 0) then
  340.                     WType = bitset(WType, 3)
  341.                 else NOP
  342.             else
  343.                 WType = bitset(WType, 7)
  344.  
  345.             /** Prepare gadgets to explain current word **/
  346.         if WType ~= null() then do
  347.             interpret 'Gad.'Gadgets+1'.6Txt = ''"''Lkup''" is'''
  348.             if bittst(WType, 0) then do
  349.                 Gadgets = Gadgets + 1
  350.                 Gad.Gadgets.6Btn = 'Function name'
  351.                 Gad.Gadgets.6Cmd = ExecStr 'link FUNCTION'
  352.             end
  353.             if bittst(WType, 1) then do
  354.                 Gadgets = Gadgets + 1
  355.                 Gad.Gadgets.6Btn = 'Function argument'
  356.                 Gad.Gadgets.6Cmd = ExecStr 'link FUNCTION'
  357.             end
  358.             if bittst(WType, 2) then do
  359.                 Gadgets = Gadgets + 1
  360.                 Gad.Gadgets.6Btn = 'String'
  361.                 Gad.Gadgets.6Cmd = ExecStr 'link STRINGEXPR'
  362.             end
  363.             if bittst(WType, 3) then do
  364.                 Gadgets = Gadgets + 1
  365.                 Gad.Gadgets.6Btn = 'Variable'
  366.                 Gad.Gadgets.6Cmd = ExecStr 'link VARIABLE'
  367.             end
  368.             if bittst(WType, 4) then do
  369.                 Gadgets = Gadgets + 1
  370.                 Gad.Gadgets.6Btn = 'Number'
  371.                 Gad.Gadgets.6Cmd = ExecStr 'link NUMBER'
  372.             end
  373.             if bittst(WType, 5) then do
  374.                 Gadgets = Gadgets + 1
  375.                 Gad.Gadgets.6Btn = 'Hex string'
  376.                 Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
  377.             end
  378.             if bittst(WType, 6) then do
  379.                 Gadgets = Gadgets + 1
  380.                 Gad.Gadgets.6Btn = 'Binary string'
  381.                 Gad.Gadgets.6Cmd = ExecStr 'link HEXSTRING'
  382.             end
  383.             if bittst(WType, 7) then do
  384.                 Gadgets = Gadgets + 1
  385.                 Gad.Gadgets.6Btn = 'Constant symbol'
  386.                 Gad.Gadgets.6Cmd = ExecStr 'link CONSTANT'
  387.             end
  388.         end
  389.     end
  390.         /* Open the rexxarplib requester window */
  391.     CPort = 'ARXTTX'
  392.     if ~InfoWin(CPort, Gadgets+2, 'Lookup:' LkUp) then return 10
  393.  
  394.  
  395.     x = 10; y = 32
  396.  
  397.     do i = 1 to Gadgets
  398.         move(CPort, x, y)
  399.         if Gad.i.6Btn = '' then
  400.             Txt = center(Gad.i.6Txt,47)
  401.         else
  402.             Txt = right(Gad.i.6Txt, 21)
  403.         call Text(CPort, Txt)
  404.         if Gad.i.6Btn > '' then
  405.             call AddGadget(CPort, 192, y - 9, i, ' 'left(Gad.i.6Btn, 26),Gad.i.6Cmd)
  406.         y = y + 15
  407.     end
  408.     call AddGadget(CPort, 10, y-4, 14, ' View ARexxGuide index ',ExecStr '"link Arx_Index/MAIN"')
  409.     call AddGadget(CPort, 344, y-4, 15, ' Cancel ', 'ExecARexxString address ARXTTX quit')
  410.  
  411.  
  412. return 0
  413.  
  414. InfoWin: procedure
  415.  
  416.     parse arg CPort, Rows, WinTitle
  417.  
  418.     PoC = address()
  419.         /** shut down previous requester if it's still around **/
  420.     if show(P, CPort) then do; address value CPort; quit; address; end
  421.     'GetWindowInfo'
  422.     x= word(result,3); y= word(result,3)
  423.     'GetScreenInfo'
  424.     PubScreen = word(result, words(result))
  425.         /* change notifyport (PoC) to a port read by this script */
  426.     address ARexx "'call CreateHost("CPort"," PoC", "PubScreen")'"
  427.         /**   Open the window   **/
  428.     idcmp = 'CLOSEWINDOW+GADGETUP'
  429.     flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+ACTIVATE'
  430.     address command 'waitforport' CPort
  431.     Height = 16+15*Rows
  432.     if rc = 0 then do
  433.         call OpenWindow(CPort, x, y, 422, Height, idcmp,flags, WinTitle)
  434.         call SetAPen(CPort, 2)
  435.         call SetNotify(CPort, CLOSEWINDOW, CPort)
  436.         return 1
  437.     else
  438.         return 0
  439.  
  440. Tab2Space:    procedure
  441.  
  442.     parse arg line
  443.     'GetPrefs tabwidth'
  444.     tabsize = result
  445.     tpos=pos('09'x,Line);
  446.     do while tpos>0;
  447.         Line=insert('',Line, tpos, tabsize-tpos//tabsize);
  448.         tpos=pos('09'x, Line,tpos+1);
  449.     end;
  450. return translate(Line,' ','09'x)
  451.  
  452. CountChar:
  453.  
  454.    parse arg IStr, Char
  455. return length(IStr) - length(compress(IStr, Char))
  456.  
  457. IsVar:
  458.     call trace b
  459.     return symbol(arg(1)) ~== 'BAD' & datatype(left(arg(1),1), m)
  460.